perm filename MSS.F4[NEW,LCS]22 blob sn#372833 filedate 1978-08-09 generic text, type T, neo UTF8
00100	C  ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200	C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
00300	
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
00600		DIMENSION LST(18),DP(0/7)
00700		COMMON /DL/X22,SAVER,NAME,EXT /RRJJ/RJJ2,RJJ(20) /FONT/JFONT
00800		1 /RINP/R(10,80),RPOS(2,50),RI(200) /RMOD/RMODE2,RSET4,IBEAM,
00900		1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
01000		1 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
01100	C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01200		COMMON  /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
01300		1 /STF/RSTFAC(0/7),RSTJ2
01400		1  /POSI/STFF(0/7),JJ2,POS  /ALF/INP(72),ML 
01500		1 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01600		1 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
01700		1 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
01800	CC	COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
01900		COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
02000		1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
02100		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
02200		1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO  /DPTR/WDS(350)
02300		1 /MKX/MKX(11) /SC/SSC(72) /JCHAR/IXX,ISEMI,IBLA,IG  
02400	CC	COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO	
02500		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
02600		1 (R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,RJQ(5))
02700		1,(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),(RJ13,RJJ(11))
02800		1,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
02900		1 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
03000		1 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
03100		1 ,(I7,INP(7)),(IM,MKS(5)),(IP,MKS(11)),(IR,MKS(13)),(IU,MKS(8)),
03200		1 (IC,MKS(12)),(IA,MKS(2)),(IFF,MKS(3)),(IT,MKS(6)),(IOO,MKS(14)),
03300		1 (IS,MKS(4)),(ID,MKS(7)),(II,MKS(10)),(IW,MKS(1)),(IH,MKS(9))
03400		1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4))
03500		DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
03600		1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
03700		1 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
03800		1 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/,
03900		1DP/8*1/,IE/'E'/,IJ/'J'/,RNW/2.44/,IL/'L'/,INN/'N'/,LCNT/1/,LIMIT
04000		1/3000/,IQ/'Q'/,IZ/'Z'/,IB/'B'/, DIS/1.0/, RHT/1.0/,EXT/'DMD'/
04100		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
04200	C THE GIANT NUMBERS ARE FOR [ AND ]
04300		DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
04400		1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
04500	C LIMIT IS MAIN ARRAY LENGTH (3000)
04600	C  350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
04700	
04800	C*****	CALL SEGFIX
04900	C  FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
05000		LCEN=0
05100		MCEN=0
05200		IDEV=5
05300		I1=0
05400	2	CALL DPYSET(1,ST,4000)
05500		CALL HYDPOG(2)
05600		CALL HYDPOG(1)
05700		CALL TYPLOC(450,0)
05800		CALL DPYBRT(5)
05900		DO 299 K=1,I
06000	CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
06100	299	RN(K)=0
06200		JFONT=0
06300		IX=0
06400		RSET4=999
06500		QUICK=0
06600		CB=0
06700	C CB IS CENTER-BIG (CENTERING RANGE=6)
06800		UD=1
06900		RL=1
07000		FSCN=LEL
07100		RPOS(1,1)=0
07200		RSZ=.845
07300		X22=0
07400		JCEN=0
07500		KCEN=0
07600		PLT=0
07700		PWDS(1)=1
07800		EDX=-1
07900		RN(2)=0
08000	C  FOR RESTART.  AVOIDS STAFF CODE NUM.
08100		SAVER=4
08200		DO 1402 K=0,7
08300	1402	RSTFAC(K)=1.
08400		REDIT=999.
08500		M=1
08600		ITEM=0
08700		ITEMX=0
08800		ZERO=-1
08900		WDS(1)=4
09000	C  DATA IN DPY ARRAY STARTS AT WD.4!
09100		I=1
09200	1100	SCORE=-1
09300	58	IGO=-1
09400		IF(I1.NE.IR)GO TO 5505
09500		I1=-1
09600		CALL NAMEXT(INP,NAME,EXT)
09700		J2=0
09800		IF(NAME.NE.IBLA)GO TO 1221
09900	C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
10000		GO TO 5505
10100	
10200	11	CALL NOTWRT
10300	57	IF(M.GT.I)GO TO 571
10400		IF(IGO)CALL DPYOUT(1)
10500	571	ITEM=ITEM+1
10600	 	IF(ITEM.LT.ILIM)GO TO 17
10700		CALL TYPSTR('**** TOO MANY ITEMS')
10800		CALL TYPINT(ITEM)
10900		CALL TYPSTR('/349')
11000		CALL TYPCRLF
11100	CCCC	TYPE 170,ITEM
11200		I=PWDS(ILIM)
11300		ITEM=ILIM-1
11400		ST2=WDS(ILIM)
11500		CALL DPYOUT(1)
11600		GO TO 1100
11700	CCC170	FORMAT(2(' **** TOO MANY ITEMS ',I3,'/299'/))
11800	17	IF(IGO.GT.0)GO TO 20000
11900		K=ST2
12000		IF(X22.EQ.0)GO TO 20000
12100		CALL BOX(IBOX,RBOX)
12200		ST2=K
12300	20000	WDS(ITEM+1)=ST2
12400		IF(EDX.EQ.-1)GO TO 1571
12500		IF(M.LT.I)GO TO 6120
12600	C  SL=SAVE AFTER RESETTING LENGTH OF PAGE.  (SEE I2 IN SCX)
12700	1571	PWDS(ITEM+1)=I
12800		PLT=0
12900		IF(IGO.NE.0)GO TO 55
13000		CALL DPYOUT(1)
13100		IF(SCORE.EQ.0)GO TO 9532
13200	C  GO GET MORE FROM SCX.
13300		IGO=-1
13400	
13500	55	IF(SCORE.EQ.0)GO TO 653
13600	5505	SVST=ST2
13700	C CATCHES TYPO WITH 'C'
13800		K=ITEM+1
13900		IF(X22.EQ.0)GO TO 5503
14000	C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
14100		IF(QUICK)5911,210,10
14200	C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS
14300	210	L=RN(MEDIT+1)
14400		K=X22
14420		IF(IDEV.EQ.1)GO TO 5503
14460	C 'FILE'CAN BE USED  WHILE IN EDIT MODE
14500	CC	IF(L.EQ.11.OR.L.EQ.12)L=9
14600	CC	IF(L.EQ.13)L=11
14700	CC	IF(L.GE.15)L=L-5
14800	CCCC	TYPE 427,LST(L),(RN(L),L=MEDIT+1,MEDIT+3)
14900		CALL TYPCRLF
15000		CALL TYPWRD(LST(L))
15100		CALL TYPCRLF
15200		CALL TYPFLT(RN(MEDIT+1))
15300		CALL TYPCHR('   ',3)
15400		CALL TYPFLT(RN(MEDIT+2))
15500		CALL TYPCHR('   ',3)
15600		CALL TYPFLT(RN(MEDIT+3))
15700	CCCCC	TYPE 1427,(RN(L),L=MEDIT+1,MEDIT+3)
15800		IF(YED.LT.2)GO TO 59
15900	C   YED IS SET AT 426
16000		DO 5501 L=4,YED+2
16100		CALL TYPCHR('   (',4)
16200		CALL TYPINT(L)
16300		CALL TYPCHR(') ',2)
16400	5501	CALL TYPFLT(RN(MEDIT+L))
16500		CALL TYPCRLF
16600	CCC5501	TYPE 4271,L,RN(MEDIT+L)
16700		GO TO 59
16800	
16900	CCCC5919	FORMAT(' ;=LFT :=RT (=UP )=DN /=HALF *=*2'/)
17000	591   	IF(X22.EQ.0)GO TO 59
17100		QUICK=-1
17200		CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
17300		CALL TYPCRLF
17400	CCCC	TYPE 5919
17500	5911	CALL FSCAN
17600	C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )=↓ /=HALF *=*2 X=X C=C OTHERS=CR
17700		GO TO 1591
17800		GO TO 2591
17900		GO TO 3591
18000		GO TO 4591
18100		GO TO 5913
18200		GO TO 6591
18300		GO TO 7591
18400		GO TO 5912
18500		I1=0
18600	5591	QUICK=0
18700		GO TO 5917
18800	
18900	1502	FORMAT(2A5)
19000	502	REREAD 1502,K,K
19100		IF(LOOK(K)+LOOKD(K))GO TO 2502
19200		CALL TYPSTR(' FILE NOT FOUND')
19300		GO TO 59
19400	2502	CALL IFILE(1,K)
19500	2503	IDEV=1
19600		GO TO 10
19700	CC	IF(I1.NE.LOH)GO TO 10
19800	3502	IDEV=5
19900		GO TO 59
20000	C RESET TO TTY MODE
20100	
20200	5503	CALL HYDPOG(3)
20300	C  TO DELETE VERTICAL LINE (55)
20400		KED=0
20500		QUICK=0
20600	C  RESET PARAM TYPE-OUT
20700		RJ13=0
20800	C KILL CENTERING FEATURE FOR NOW
20900	CC** NEXT DOES THIS FASTER*** 59	TYPE 56,NAME,K,I,SVST
21000	59	IF(IDEV.EQ.1)GO TO 10
21100		CALL TYPCRLF
21200		CALL TYPWRD(NAME)
21300		CALL TYPSTR('     TYPE FOR ITEM #')
21400		CALL TYPINT(K)
21500		CALL TYPSTR('           ')
21600		CALL TYPINT(I)
21700		CALL TYPSTR(' ')
21800		CALL TYPINT(SVST)
21900		CALL TYPCRLF
22000	10	SCORE=-1
22100	CQQ	ACCEPT 89,INP
22200		READ(IDEV,89,END=3502)INP
22300		IF(I1.EQ.LESS)GO TO 3502
22400	C  '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
22500		IF(I1.NE.IGT)GO TO 1000
22600		IF(X22.NE.0)GO TO 59
22700	C  '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
22800		GO TO 2503
22900	1000	IF(IDEV.EQ.5)GO TO 4502
23000		IF(I7.NE.IT)GO TO 4502
23100		IF(I1.NE.LCC)GO TO 4502
23200	C 'ET' DIRECTORY? UGH!!!
23300	6502	READ(IDEV,89)INP
23400		IF(I3.NE.ISEMI)GO TO 6502
23420		READ(IDEV,89)INP
23460	C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
23500		GO TO 10
23600	4502	REREAD 1,J,R2,RJQ
23700	C  ↑↑↑ 1/78
23800	C ↓↓↓↓ FIRST CATCHES BLANKS, NUMBERS, ETC.
23900	5917	IF(I1.GE.MINUS)GO TO 110
24000		IF(I1.EQ.IBLA)GO TO 110
24100		IF(I1.EQ.II)GO TO 678
24200	C IN, ITEM
24300		IF(I1.EQ.IXX)GO TO 78
24400	C X=EXIT
24500		IF(I1.EQ.LEL)GO TO 778
24600	C L=LEFT, LP=LIGHT PEN
24700		IF(I1.EQ.IU)GO TO 883
24800	C UP
24900		IF(I1.EQ.IR)GO TO 8835
25000	C R=RIGHT, RI=RIT, READ, RS=RESTART
25100		IF(I1.EQ.LDD)GO TO 478
25200	C D=DOWN, DI=DIM, DE=DELETE
25300		IF(I1.EQ.LCC)GO TO 178
25400	C C=COPY, CR=CRESC., CN=CENTER, CH=ON HEAD, CT=ON TAIL
25500		IF(I1.EQ.IS)GO TO 15
25600	C SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
25700		IF(I1.EQ.LEE)GO TO 878
25800	C ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM. FIRST
25900		IF(I1.EQ.INN)GO TO 410
26000	C N=NO TYPE
26100		IF(I1.EQ.IP)GO TO 33 
26200	C P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,PL=PLUS
26300		IF(I1.EQ.LAA)GO TO 378
26400	C A=ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
26500		IF(I1.EQ.IQ)GO TO 591
26600	C Q=QUICK
26700		IF(I1.EQ.IT)GO TO 441
26800	C T=TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
26820		IF(I1.EQ.LFF)GO TO 2442
26860	C F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
26900		IF(X22.NE.0)GO TO 59
27000	C NEXT CANNOT HAPPEN IN EDIT MODE.
27100		IF(I1.EQ.IZ)GO TO 24
27200	C ZOOM
27300		IF(I1.EQ.IM)GO TO 7555
27400	C M=MOVE, ME=MENO, MO=MOLTO, MF,MP
27500		IF(I1.EQ.IJ)GO TO 7555
27600	C JUSTIFY 
27900		IF(I1.EQ.LGG)GO TO 120
28000	C GET, GM=GET MORE
28100		IF(I1.EQ.LHH)GO TO 1678
28200	C H=HARMONIC, HW=HEAVY WEDGE
28300		IF(I1.EQ.IW)GO TO 1778
28400	C W=WEDGE ACCENT
28500		IF(I1.EQ.'(')GO TO 7378
28600		IF(I1.EQ.')')GO TO 7478
28700		IF(I1.EQ.',')GO TO 7778
28800	C LEFT AND RIGHT PARENTHESES AND COMMA
28900		IF(I1.NE.LBB)GO TO 59
29000	C******* ADD MORE LETTER ITEMS HERE *************
29100	C BRC=BRACE, BRK=BRACKET  -- FOR FRONT OF LINE.  BAR=BAR LINE.
29200		IF(X22.NE.0)GO TO 59
29300		REREAD 1,JA,JA,JA,R2,RJQ
29400		J=4
29500		R7=4
29600		IF(I3.EQ.IR)R7=0
29700		IF(I3.EQ.LCC)R7=5
29800		GO TO 110
29900	
30000	378	IF(I2.EQ.LDD)GO TO 886
30100	C 'A'  = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
30200		IF(X22.NE.0)GO TO 886
30300		IF(I2.EQ.IT)GO TO 7178
30400	C AT=A TEMPO
30500		IF(I2.EQ.IR)GO TO 7278
30600	C AR=ARCO
30700		IF(I2.NE.LCC)GO TO 112
30800		IF(I3.EQ.IT)GO TO 1278
30900	C ACT=ACCENT.   NEXT FOR AC (=ACCEL.)
31000		RD=80
31100		GO TO 1442
31200		
31300	478	IF(I2.GE.IBLA)GO TO 883
31400	C 'D'  DIM →578, DOWN →883, DELETE →112 OR 883  DP →886
31500		IF(I2.NE.LEE)GO TO 578
31600		IF(X22.NE.0)GO TO 883
31700		GO TO 112
31800	578	IF(I2.EQ.IP)GO TO 886
31900		IF(I2.NE.II)GO TO 59
32000	C NEXT FOR DIM.=82
32100		IF(X22.NE.0)GO TO  59
32200		RD=82
32300		GO TO 1442
32400	
32500	1591	I1=LEL
32600	9591	FSCN=I1
32700		GO TO 5917
32800	2591	I1=IR
32900		GO TO 9591
33000	3591	I1=IU
33100		GO TO 9591
33200	4591	I1=LDD
33300		GO TO 9591
33400	7591	I1=IXX
33500		GO TO 5591
33600	5912	I1=LCC
33700		GO TO 5591
33800	5913	I1=FSCN
33900		IF(FSCN.EQ.LEL)GO TO 5914
34000		IF(FSCN.EQ.IR)GO TO 5914
34100	C NEXT FOR UP-DOWN
34200		UD=UD/2
34300		GO TO 5917
34400	5914	RL=RL/2
34500		GO TO 5917
34600	6591	I1=FSCN
34700		IF(I1.EQ.LEL)GO TO 5916
34800		IF(I1.EQ.IR)GO TO 5916
34900		UD=UD*2
35000		GO TO 5917
35100	5916	RL=RL*2
35200		GO TO 5917
35300	
35400	
35500	C  'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF.
35600	C  SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
35700	15	IF(I2.EQ.IT)GO TO 885
35800		IF(I2.EQ.LAA)GO TO 3121
35900		IF(I2.EQ.LCC)GO TO 886 
36000		IF(I2.EQ.LDD)GO TO 3121
36100		IF(I2.EQ.LEE)GO TO 312 
36200		IF(I2.EQ.IBLA)GO TO 312 
36300		IF(I2.EQ.IP)GO TO 87
36400		IF(I2.EQ.LHH)JFONT=1
36500		IF(I3.EQ.IXX)JFONT=0
36600		IF(I3.EQ.IP)JFONT=-1
36700		IF(I3.EQ.LOH)JFONT=-2
36800		IF(I3.EQ.II)JFONT=-3
36900	C  'SH'(=SHOW) IS SAME AS 44 1.  SHOWS TYPE FONTS ON DPY.
37000	C  'SHP' = SHOW ONLY AS 'PRIMATIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
37100	C  'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
37200		IF(I2.NE.LFF)GO TO 3122
37300		RD=45
37400		IF(I3.NE.IZ)GO TO 1442
37500		RD=92
37600	3123	REREAD 1,JA,JA,JA,R2,RJQ
37700		R5=RD
37800		GO TO 442
37900	3122	IF(I2.NE.IM)GO TO 5505
38000	C  ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
38100	3121	IF(X22.NE.0)GO TO 5505
38200		SAVER=4
38300		CALL SAVIT
38400		GO TO 5505
38500	312	JA=55
38600		R2=RN(MEDIT+3)
38700	C  POSITION OF ITEM LOOKED AT.
38800		R3=55.
38900		GO TO 6531
39000	C  ABOVE FOR 'S'ET ALIGNMENT
39100	C  'S'=SET ALIGNMENT, 'A'=ALIGN IT.  'M'=MOVER 'C'= COPIER
39200	C  'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
39300	878 	K=-1
39400		DO 882 JA=3,10
39500	882	IF(INP(JA).NE.IBLA)GO TO 886
39600		GO TO 883
39700	885	FORMAT(A2,21F)
39800		IF(X22.NE.0)GO TO 59
39900	C CAN'T DO 'ST' IF ALREADY IN EDIT MODE.
40000		IF(I3.EQ.LCC)GO TO 1578
40100	C STC=STACCATO
40200	886	REREAD 885,K,R2,RJQ
40300		JA=55
40400		IF(I2.NE.LCC)GO TO 101
40500		CALL SCL
40600		GO TO 5505
40700	101	IF(I2.NE.LDD)GO TO 988
40800		IF(I1.EQ.LAA)JA=19
40900	C  'AD'just stems to beams.
41000	988	IF(I2.EQ.IT)JA=44
41100		IF(I2.EQ.INN)GO TO 188
41200		IF(I2.NE.IP)GO TO 6531
41300		IF(R2.GT.7)GO TO 1886
41400	C  GO BACK AND RESET ALL IF STF NUM >7
41500		K=R2
41600		JA=0
41700	C  USE '8' FOR STAFF 0.
41800	888	IF(K.EQ.8)K=0
41900		DP(K)=-DP(K)
42000		JA=JA+1
42100		K=RJQ(JA)
42200		IF(K.EQ.0)GO TO 55
42300	C  JUMP OUT IF RJQ(JA)=0 OR 99
42400		IF(K.EQ.99)GO TO 85
42500	C*** 3/74  END WITH '99' TO MAKE DP RIGHT NOW!
42600		GO TO 888
42700	1886	DO 2886 K=0,7
42800	2886	DP(K)=1
42900		GO TO 85
43000	C  TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
43100	
43200	778	IF(I2.NE.IP)GO TO 883
43300	C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
43400	78	IF(X22.EQ.0)GO TO 59
43500	C 'X'  GO BACK IF NOT IN EDIT MODE
43600	
43700	C NEXT FOR READ, RS, DEL, L,R,U,D
43800	883	IF(IX.EQ.I)GO TO 8834
43900	C  CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
44000		IF(I2.NE.LEE)GO TO 8831
44100		GO TO 5505
44200	
44300	8835	IF(I2.GE.IBLA)GO TO 8831
44400	C R=RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
44500		IF(X22.NE.0)GO TO 59
44600	C GO BACK IF STILL IN EDIT MODE.
44700		IF(I2.EQ.IS)GO TO 2
44800	C  TYPE 'RS' TO RESTART.
44900		IF(I2.NE.II)GO TO 8830
45000	C NEXT FOR RIT.=37
45100		RD=37
45200		GO TO 1442
45300	
45400	8830	JA=144
45500	C  'READ' IS SAME AS 144
45600		GO TO 88
45700	
45800	8834	IF(I1.EQ.LCC)GO TO 72
45900	8831	IF(JA.NE.16)GO TO 8832
46000		IF(X22.EQ.0)GO TO 5505
46100	C  CAN'T MOVE LETTERS OR 'SCORE' ENTRIES UNLESS REALLY IN EDIT MODE!
46200	8832	CALL EDIT(JJA)
46300		IF(JA.NE.99)GO TO 6531
46400		CALL DELETE
46500	C  DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
46600		GO TO 425
46700	89	FORMAT(72A1)
46800	C  TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
46900	
47000	410	IF(QUICK.NE.0)GO TO 510
47100	C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
47200		QUICK=1
47300	C TYPE 'N'  =NO-TYPE PARAMS  TO SUPPRESS TYPE-OUT WHILE EDITING.
47400		IF(X22.NE.0)GO TO 87
47500	510	I1=II
47600	C  'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
47700	87	IF(I1.NE.II)GO TO 610
47800	678	IF(I2.EQ.INN)GO TO 886
47900	C  'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
48000		JA=22
48100		GO TO 6531
48200	
48300	610	IF(K)JA=55
48400	C   ED 47 -1 = 55 47 -1, ETC.
48500		IF(JA.EQ.101)GO TO 101
48600		IF(I1.NE.INN)GO TO 710
48700		IF(R2.NE.0)GO TO 510
48800	C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
48900		GO TO 10
49000	
49100	C  'Z' = ZOOM  (OLD CODE# 24)
49200	710	IF(I2.NE.IP)GO TO 441
49300		RSET4=R3
49400	C SPn SETS "SETUP" STAFF NUMBER
49500		GO TO 5505
49600	C  'SP' IS SAME AS 444
49700	C  'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
49800	441	IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 288
49900	C JUMP OUT IF 'TL' (TYPLOC)
50000		QUICK=0
50100	C TYPE 'T' TO RESET PARAM TYPE-OUT
50200		IF(R2.EQ.0)GO TO 5505
50300		GO TO 510
50400	
50500	1078	RD=14
50600	C PLUS
50700	1178	REREAD 885,JA,R2,RJQ
50800	1378	J=9
50900		R5=RD
51000		IF(R4.EQ.0)R4=15
51100		GO TO 110 
51200	1278	RD=5
51300	C ACCENT
51400	1478	REREAD 1,J,J,J,R2,RJQ
51500		GO TO 1378
51600	1578	RD=7
51700	C STACC.
51800		GO TO 1478
51900	1678	RD=13
52000	C HARMONIC
52100		IF(I2.EQ.IW)RD=21
52200	C HEAVY WEDGE
52300		GO TO 1178
52400	1778	RD=4
52500	C WEDGE
52600		GO TO 1178
52700	
52800	3442	REREAD 885,JA,R2,RJQ
52900		R5=26
53000		J=9
53100		IF(R4.EQ.0)R4=12
53200	C FERMATA 
53300		GO TO 110
53400	
53480	2442	IF(I2.EQ.II)GO TO 502
53490		IF(X22.NE.0)GO TO 59
53500		R5=51
53600	C F=51 FF=52 FFF=53, FE=FERMATA, FILE
53700		IF(I2.EQ.IBLA)GO TO 442
53800		IF(I2.EQ.LEE)GO TO 3442
54000		RD=53
54100		IF(I3.NE.IBLA)GO TO 3123
54200		RD=52
54300	1442	REREAD 885,JA,R2,RJQ
54400		R5=RD
54500	442	J=3
54600		IF(R4.EQ.0)R4=-5
54700	C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.  
54800	C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
54900	110	JA=J
55000		IF(JA.GT.0)SAVER=SAVER-1
55100		IF(X22.NE.0)GO TO 6531
55200		IF(SAVER)CALL SAVIT
55300	C  SAVES EVERY 4TH TIME AROUND
55400		IF(JA.EQ.0)GO TO 5505
55500	C  CATCHES ZEROS AND LOWER CASE LETTERS.
55600		GO TO 6531
55700	C NEXT FOR ALPHA TEXT ITEMS.  'T'=TYPE
55800	288	IF(I2.NE.LEE)GO TO 388
55900		RD=9
56000	C TENUTO
56100		GO TO 1178
56200	388	IF(I2.NE.LEL)GO TO 488
56300		J3=R3
56400		J4=R4
56500	C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
56600		IF(J4.EQ.0)J4=J3-200
56700	C OMIT 2ND NUM. AND GET N AND N-200.
56800		IF(R3.NE.0)GO TO 588
56900		IF(R4.NE.0)GO TO 588
57000		J4=0
57100		J3=450
57200	C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
57300	588	CALL TYPLOC(J3,J4)
57400		GO TO 5505
57500	488	JA=16
57600	C 'T' = TEST INPUT
57700		J2=R2
57800		M=I
57900		CALL WORDS
58000		SAVER=SAVER-1
58100		GO TO 8852
58200	
58300	188	IF(X22.NE.0)GO TO 5505
58400		JA=14
58500		RMODE2=R3
58600	C  TYPE 'IN STF# MODE' ETC.  -- SAME AS 14 STF#.
58700	88	SCORE=0
58800		IF(JA.NE.14)GO TO 889
58900	C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
59000		SAVER=-1
59100		RSTF=R2
59200		IF(R3)R3=0
59300		DO 1889 K=1,ITEM
59400		J=PWDS(K)
59500		IF(RN(J+1).NE.8)GO TO 1889
59600		IF(RN(J+2).EQ.R2)GO TO 890
59700	1889	CONTINUE
59800	C DIDN'T FIND THIS STAFF
59900		M=LIMIT
60000	C ↑↑ WAS =2000 6/78
60100		IGO=0
60200		JA=8
60300		R3=0
60400		GO TO 6531
60500	890	JA=14
60600		ITCHK=ITEM
60700		ICHK=I
60800		IDPY=ST2
60900	C ALL THIS FOR BACKUPS
61000	889	SPD=ST2
61100		JIT=ITEM
61200		ISC=I
61300		REND=0
61400	C   RETAINS ORIGINS OF SCORE SQUENCE
61500	9532	IF(REND.EQ.2)GO TO 889
61600	C  FOR READIN CONTINUATION.
61700		M=ISC
61800	9533	IF(JA.EQ.8)GO TO 890
61900		IF(REND)GO TO 9535
62000	C REND=0 GO,  -1=NORMAL END,  1=ABORTED.
62100		CALL SCMSS
62200		IF(REND.EQ.1)GO TO 9535
62300		IF(REND.NE.99)GO TO 9534
62400		I=ICHK
62500		ITEM=ITCHK
62600		ST2=IDPY
62700		CALL ACCPOG(1)
62800		CALL DPYOUT(1)
62900		GO TO 9535
63000	9534	ITEM=JIT
63100		J=M
63200	9536	ITEM=ITEM+1
63300		PWDS(ITEM)=J
63400		J=J+RN(J)+3
63500		IF(J.LT.I)GO TO 9536
63600		IF(IBEAM)GO TO 9537
63700		R13=0
63800		R2=RSTF
63900		JA=19
64000		J3=0
64100		CALL HOMER
64200	9537	ITEM=JIT
64300		ST2=SPD
64400		GO TO 8852
64500	9535	SCORE=-1
64600		CALL SHRINK(JIT)
64700	C  GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
64800		IGO=-1
64900		JA=16
65000	C  FOR TRAP AT 'EDIT'
65100		GO TO 5505
65200	
65300	112	IGO=1
65400		CALL GRED
65500		JFONT=0
65600		IF(JA.EQ.98)GO TO 5533
65700		KNT=0
65800		SCORE=0
65900	
66000	653	KNT=KNT+1
66100	C   NUM OF ITEMS IN LIST
66200		R11=0
66300		R10=0
66400		R9=0
66500		JA=R(1,KNT)
66600		R2=R(2,KNT)
66700		IF(JA.NE.0)GO TO 550
66800	C  =0 MEANS NO MORE ITEMS.
66900		CALL DPYOUT(1)
67000		GO TO 1100
67100	
67200	5533	X22=0
67300		IGO=-1
67400		CALL DPYNEW
67500		GO TO 55
67600	
67700	550	DO 7531 K=1,6
67800	7531	RJQ(K)=R(K+2,KNT)
67900	6531	M=1
68000		EDX=-1
68100		IF(JA.EQ.222)GO TO 72
68200		IF(JA.EQ.2222)GO TO 73
68300		DO 5532 K=1,20
68400	5532	JQ(K)=RJQ(K)
68500	C  X22= ITEM# WHEN EDITING OR DELETING.
68600		IF(X22.NE.0)GO TO 5511
68700		IF(JA.GT.0)GO TO 155
68800		IF(R2.EQ.0)GO TO 5505
68900	C  FOR UP, DOWN, LEFT, RIGHT
69000		RJJ2=J2
69100		GO TO 6221
69200	C  GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
69300	155	IF(JA.EQ.22)GO TO 42  
69400		IF(JA.EQ.44)GO TO 44
69500	C  THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
69600		IF(JA.EQ.55)GO TO 554
69700		IF(JA.NE.19)GO TO 60
69800	271	CALL HOMER
69900		GO TO 8853
70000	
     

00100	33	IF(X22.EQ.0)GO TO 6333
00200	C  WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2.
00300		J2=R2
00400		TYPE 331,J2,RJJ(J2-2)
00500	C  TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
00600		GO TO 5505
00700	331	FORMAT(I,F15.5)
00800	
00900	24	IF(X22.NE.0)GO TO 59  
01000	C 'Z' = ZOOM   CAN'T DO ZOOM WHILE IN EDIT MODE
01100		JA=24
01200		IGO=0
01300	23	IF(R2.LT.100)GO TO 2410
01400		R3=AMOD(R2,100.)
01500		R2=(R2-R3)/100.
01600		R4=R2*6-R2
01700	C TYPE 24 200.5 FOR 1ST HALF OF DOUBLE, 301 FOR LAST THIRD OF TRIPLE
01800	2410	IF(R2.NE.0)GO TO 241
01900		IGO=-1
02000	243	R2=1.
02100	C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
02200	241	RSZ=.845*R2
02300		JCEN=(R3*10-500)*RSZ
02400		KCEN=(R4*10-480)*RSZ
02500	C  NEXT TO RECONSTITUTE SPACING SCALE.
02600		IF(R2.GT.1)GO TO 240 
02700		JCEN=0
02800		KCEN=0
02900		IF(R2.EQ.1)GO TO 3312
03000	240	R2=(R4-100.)/100.
03100	C%%%%%%%%%%%%%
03200		IF(R2.LT.0)R2=0
03300	C  WE DON'T WORRY IF IT'S TOO HIGH (YET).
03400	3312	R4=0
03500		R2=R2+1
03600		CALL SCL
03700		R2=0
03800		R3=0
03900		R4=0
04000		LCEN=0
04100		MCEN=0
04200	C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
04300		JFONT=0
04400	85	M=1
04500		I=PWDS(ITEM+1)
04600		ITEMX=ITEM
04700	C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
04800		ITEM=0
04900	8552	ST2=3
05000	8852	PLT=1
05100		EDX=0
05200		CALL ACCPOG(1)
05300		IF(JA.EQ.0)GO TO 6120
05400		IF(JA.NE.24)IGO=0
05500		GO TO 6120
05600	
05700	6333	IF(I2.EQ.IR)GO TO 6334
05800	C NOW TYPE 'PR' TO PRINT PARAMETER LIST
05900		R5=42
06000		IF(I2.EQ.IBLA)GO TO 442
06100		IF(I2.EQ.IP)RD=41
06200	C PPP=40 PP=41 P=42 POCO=72 PIU=91
06300		IF(I2.EQ.II)RD=91
06400		IF(I2.EQ.LOH)RD=72
06500		IF(I2.EQ.LEL)GO TO 1078
06600	C PLUS
06700		IF(I2.EQ.IZ)GO TO 7078
06800	C PIZZ
06900		IF(I3.EQ.IBLA)GO TO 1442
07000		RD=40
07100		GO TO 3123
07200	6334	CALL LISTP(LST)
07300		GO TO 5505
07400	
07500	7078	RA=51857895.
07600		RB=95389999.
07700	C PIZZ.
07800	7578	RD=0
07900	7978	RE=1
08000	7878	J=16
08100		REREAD 885,JA,R2,RJQ
08200		R6=RA
08300		R7=RB
08400		R8=RD
08500		IF(R5.EQ.0)R5= RE
08600		IF(R4.EQ.0)R4=14
08700	C 0=PUT IT ABOVE STAFF
08800		GO TO 110
08900	7178	RA=51704789.
09000		RB=74828584.
09100		RD=99999999.
09200	C A TEMPO
09300		GO TO 7978
09400	7278	RA=51708772.
09500		RB=84999999.
09600	C ARCO
09700		GO TO 7578
09800	7378	RA=40999999.
09900	7678	RB=0
10000		GO TO 7578
10100	C LEFT AND RIGHT PARENTHESES AND COMMA
10200	7478	RA=41999999.
10300		GO TO 7678
10400	7778	RA=36999999.
10500		RB=0
10600		RD=0
10700		RE=1.5
10800	C COMMA IS DEFAULT SIZE 1.5
10900		GO TO 7878
11000	
11100	172	CALL JUGGLE
11200		CALL CLRCUR
11300		CALL DPYNEW
11400		IF(JA.EQ.22)GO TO 424
11500	C  FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
11600		IF(ZERO)GO TO 55
11700		X22=ZERO
11800		ZERO=-1
11900		IF(JA.EQ.55)GO TO 554
12000		IF(JA.EQ.44)GO TO 44
12100		IF(KED.NE.0)GO TO 244
12200		GO TO 425
12300	
12400	C  55,POS  -- SETS UP ALIGNMENT
12500	554	IF(I2.NE.IS)GO TO 2554
12600		CALL EXCH(R2,R3)
12700		CALL EXCH(J2,J3)
12800	C 'ES' IS "EDIT, STAFF, POS., CODE"
12900	C 'ED' IS "EDIT, POS., STAFF, CODE"
13000	2554	CALL BOX(-1,R2)
13100		IF(J4.EQ.0)KED=-1
13200		RITEM=R4
13300	C  FOR 'ED POS., STF., CODE#'   (STF > 7 = ALL STAVES)
13400		IF(J3.GT.7)KED=-2
13500		RLINE=R2
13600		R2=R3
13700		GO TO 45
13800	
13900	C  '22,0' EDITS LAST ITEM ENTERED
14000	42	REDIT=999.0
14100		IF(R2.NE.0)GO TO 242
14200		X22=ITEM
14300		GO TO 429
14400	44	KED=1	
14500		RITEM=R3
14600	C  'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
14700		IF(R2.GT.7)KED=2
14800	45	REDIT=R2
14900	C  THE STAFF #
15000		JED=1
15100	244	X=ITEM  
15200		IF(JED.GT.X)GO TO 444
15300		DO 144 K=JED,X
15400		L=PWDS(K)
15500		IF(KED.EQ.-2)GO TO 654
15600	C  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
15700		IF(KED.EQ.2)GO TO 656
15800		IF(RN(L+2).NE.REDIT)GO TO 144
15900		IF(KED)GO TO 654
16000		IF(RITEM.EQ.0)GO TO 655
16100	656	IF(RITEM.NE.RN(L+1))GO TO 144
16200	655	IF(JA.NE.55)GO TO 344
16300	654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
16400	144	CONTINUE
16500	444	REDIT=999.
16600	C  NO MORE ON LINE
16700		R2=0
16800	C   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
16900		GO TO 73
17000	344	JED=K+1
17100	C  FOR NEXT TIME AROUND
17200		X22=K
17300		GO TO 429
17400	C  CR MOVES ALONG GIVEN LINE,  222 LEAVES THIS MODE
17500	
17600	91	CALL ACCPOG(1)
17700		IF(I.EQ.IX)ITEM=ITEM-1
17800		GO TO 142
17900	242	IF(X22.GT.0)GO TO 5511
18000	142	IF(R2.NE.0)GO TO 424
18100		IF(REDIT.EQ.999)GO TO 1554
18200		IF(JA.GE.0)GO TO 244
18300	1554	X22=X22+1
18400		IF(JA)X22=X22-1+JA
18500		IF(X22.LT.1)X22=1
18600		GO TO 425
18700	CCC427	FORMAT(1XA5/,2F6.0,F10.2,$)
18800	CC1427	FORMAT(/,2F6.0,F10.2,$)
18900	CCC4271	FORMAT('+  (',I2,')',F7.2,$)
19000	
19100	C  FOR EDITING
19200	5511	IF(JA.EQ.55)GO TO 420
19300	220	IF(JA.NE.22)GO TO 720
19400	C  'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
19500		KED=0
19600		JED=0
19700		GO TO 72
19800	720	IF(JA.EQ.44)GO TO 420
19900	C  FOR '24' WHILE IN EDIT MODE.  MAGS WITH CURSOR AS CENTER.
20000		IF(JA.GT.100)GO TO 4221
20100		IF(JA.GT.13)GO TO 5505
20200	C  PARAM NUM TOO HIGH?  LOOKS FOR NEXT ITEM TO EDIT IF <CR>
20300	4221	IF(X22.EQ.0)GO TO 5517
20400		IF(R2.NE.0)GO TO 5517
20500	C  BACKS UP WHEN IN EDIT MODE.
20600	
20700		IF(JA.GT.0)GO TO 5518
20800		IF(I.EQ.IX)GO TO 91
20900		ZERO=X22+1
21000	C  '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
21100	72	IF(X22.EQ.0)GO TO 55
21200		IF(KED.EQ.0)REDIT=999.
21300	320	IF(I.NE.IX)GO TO 172
21400		ITEM=ITEM-1
21500	C  TO DELETE AN ITEM
21600	73	X22=0 
21700		CALL CLRCUR
21800		CALL DPYNEW
21900		IF(REDIT.EQ.999.)GO TO 428
22000		IF(JA.EQ.55)GO TO 554
22100		IF(JA.EQ.44)GO TO 44
22200	428	IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 55
22300	C  DELETION IN EDIT MODE DOES NOT LEAVE MODE.
22400	424	X22=R2
22500	425	IF(X22.GT.ITEM)GO TO 73
22600	C  LEAVES EDIT MODE.
22700	429	IX=I
22800		MEDIT=PWDS(X22)
22900		J=2
23000	426	Y=RN(MEDIT)+J
23100		CALL LOOP(0,Y,1,I,MEDIT,RN)
23200		JJA=RN(I+1)
23300		YED=Y-2
23400		L=I+2
23500		DO 422 K=1,11
23600		IF(K.GT.YED)GO TO 423
23700		RJJ(K)=RN(L+K)
23800		GO TO 422
23900	423	RJJ(K)=0
24000	422	CONTINUE
24100		RJJ2=RN(L)
24200		IF(IGO.GT.0)GO TO 4231
24300	C  NO BOX WHEN IN GROUP EDIT ROUTINE
24400		IBOX=I
24500		RBOX=RJJ2
24600		CALL BOX(IBOX,RBOX)
24700	4231	ITEM=ITEM+1
24800		ST2=WDS(ITEM)
24900		GO TO 55
25000	
25100	5517	IF(JA.EQ.0)GO TO 6221
25200	5518	X=100-JA
25300		IF(X)JA=JA/100
25400		IF(JA.LE.2)GO TO 7221
25500		IF(JA.LE.13)GO TO 324
25600		JA=JA/10
25700	C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
25800		X=R2-2.
25900		RJJ(JA-2)=RJJ(X)
26000		GO TO 6222
26100	324	I1=JA-2
26200		IF(X)GO TO 224
26300		RJJ(I1)=R2
26400		GO TO 6222
26500	224	RJJ(I1)=RJJ(I1)+R2
26600		GO TO 6222
26700	
26800	178	IF(X22.EQ.0)GO TO 7555
26900	C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
27000		IF(I2.EQ.IBLA)GO TO 883
27100		R2=1
27200	C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
27300		JA=13
27400		IF(I2.EQ.IXX)R2=0
27500		IF(I2.EQ.LHH)R2=-R2
27600		IF(I2.EQ.IT)R2=-2
27700		IF(I2.EQ.LBB)CB=6
27800	C TYPE 'CB' FOR CENTER-BIG  (BIG RANGE =6) ******
27900		GO TO 6531
28000	CC278	IF(X22.NE.0)GO TO 59
28100	7555	IF(I2.EQ.IBLA)GO TO 7556
28200	C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50
28300		RD=43
28400		IF(I2.EQ.LFF)RD=50
28500		IF(I2.EQ.LOH)RD=90
28600		IF(I2.EQ.LEE)RD=81
28700		IF(I2.EQ.IR)RD=70
28800		GO TO 1442
28900	7556	CALL MOVER
29000		IF(R2.EQ.99)GO TO 59
29100	C   99=BACKUP OUT OF MOVER ETC.
29200		IGO=0
29300		JFONT=0
29400	C  SO IT WON'T DO ALL FONT LOOKUPS.
29500	8853	IF(JJ2)GO TO 5505
29600		M=PWDS(JJ2)
29700		I=PWDS(ITEM+1)
29800		ITEM=JJ2-1
29900		ST2=WDS(JJ2)
30000	C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
30100		GO TO 8852
30200	
30300	420	REDIT=0
30400	211	IF(R2.NE.0)GO TO 320
30500		IF(KED.GE.0)RLINE=RJ3
30600		RJ3=RLINE
30700		GO TO 6222
30800	C  FOR '55' ALIGNING
30900	7221	IF(X)GO TO 4223
31000		CALL PARCH(JA,JJA,R2)
31100		GO TO 6222
31200	4223	RJJ2=R2+RJJ2
31300	C  ARRAYS NEED 2O LOCATIONS HERE.
31400	C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122  4,13  5,-2 ETC.)
31500	6222	DO 1222 K=1,20,2
31600		L=JQ(K)
31700		IF(L.EQ.0)GO TO 6221
31800	C  '600 2'  WILL ADD 2 TO PARAM 6.  '3000 6' SETS P3=P6.
31900		RD=RJQ(K+1)
32000		X=L
32100		IF(L.LT.100)GO TO 223
32200		IF(L.LT.2000)GO TO 5223
32300		X=L/1000
32400		L=JQ(K+1)-2
32500		RD=RJJ(L)
32600		GO TO 2223
32700	5223	X=L/100
32800		IF(X.EQ.2)GO TO 1223
32900		RD=RJJ(X-2)+RD
33000		GO TO 2223
33100	1223	RD=RJJ2+RD
33200	223	IF(X.LE.2)GO TO 3223
33300	2223	RJJ(X-2)=RD
33400		GO TO 1222
33500	3223	CALL PARCH(X,JJA,RD)
33600	C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
33700	1222	CONTINUE
33800	C***  LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
33900	6221	DO 5514 K=1,11
34000		R2=RJJ(K)
34100		RJQ(K)=R2
34200	5514	JQ(K)=R2
34300		R2=RJJ2
34400		JA=JJA
34500		ITEM=ITEM-1
34600		IF(ITEM)ITEM=0
34700		ST2=WDS(ITEM+1)
34800		I=PWDS(ITEM+1)
34900		CALL DPYNEW
35000	
     

00100	60	J2=R2
00200		IF(J2.LT.0)GO TO 5505
00300		IF(J2.GT.7)GO TO 5505
00400	C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
00500		RSTJ2=RSTFAC(J2)
00600	C*	IF(JA.NE.2)GO TO 163
00700	C*	IF(R8.EQ.0)GO TO 163
00800	C*	IF(R8.EQ.-1)GO TO 163
00900	C*	IF(R8.EQ.-4)GO TO 163
01000	C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
01100	C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
01200	C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
01300	C*	K=ITEM
01400	C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
01500	C*	IF(X22.NE.0)K=X22-1
01600	C*	RD=1.75*RSTJ2
01700	C*	L=PWDS(K+2)
01800	C*	IF(RN(L+1).NE.4)GO TO 164
01900	C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
02000	C*	IF(RN(L+2).NE.R2)GO TO 164
02100	C*	RB=RN(L+3)
02200	C*	L=PWDS(K)
02300	C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
02400	C*	IF(RN(L+1).NE.4)GO TO 164
02500	C*	IF(RN(L+2).NE.R2)GO TO 164
02600	C  JUMP IF NOT ON SAME STAFF
02700	C*	RA=RN(L+3)
02800	C*	R3=RA+(RB-RA)/2-1.75*RSTJ2
02900	C*164	IF(PLT.EQ.0)GO TO 160 
03000	C*	RN(PWDS(K+1)+3)=R3
03100	C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
03200	C*	GO TO 5541
03300	
03400	163	IF(JA.EQ.16)GO TO 63
03500		IF(PLT.NE.0)GO TO 5541
03600		IF(JA.NE.8)GO TO 70
03700		IF(R9.NE.1)GO TO 160
03800		L=7
03900		K='INST.'
04000	C  RJQ(7) IS R9
04100	71	RA=RN(MEDIT+L+2)
04200		CALL TYPCHR(RA,5)
04300	CCCC	TYPE 427,RA
04400		CALL TYPCRLF
04500		CALL TYPSTR('TYPE ')
04600		CALL TYPCHR(K,5)
04700		CALL TYPSTR(' NAME   ')
04800	CCC721	FORMAT(' TYPE ',A5,' NAME  '$)
04900	CCC	TYPE 721,K
05000		READ(IDEV,FA5)RD
05100		RJQ(L)=RD
05200		IF(RD.NE.' ')GO TO 160
05300		IF(RN(MEDIT).LT.L)RA=0
05400	C  RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
05500		RJQ(L)=RA
05600	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
05700		GO TO 160
05800	CF371	FORMAT(A5,A1,A3)
05900	70	IF(JA.NE.11)GO TO 160
06000	C  ↑↑↑↑ WAS - TO 63
06100		IF(J10.NE.1)GO TO 160
06200		K='FILE'
06300		L=8
06400	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
06500		GO TO 71
06600	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
06700	63	RD=R5
06800		IF(RD.GE.100)RD=RD-100
06900	C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE.
07000		IF(J10.EQ.0)GO TO 162
07100		L=ITEM
07200		IF(X22.NE.0)L=X22-1
07300		IF(J10.EQ.1)GO TO 263
07400	C ↓↓↓↓ TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE.  "10 99"
07500		IF(J10.NE.99)GO TO 863
07600		X=PWDS(X22)+6
07700		DO 563 L=X,X+2
07800		RB=RN(L)
07900		K=RB
08000	C  CHECKS TO SEE WHICH FORMAT
08100	563	IF(K.NE.RB)GO TO 663
08200		GO TO 57
08300	663	DO 763 L=X,X+2
08400	763	RN(L)=RN(L)*100.
08500		GO TO 57
08600	
08700	C  NEXT FOR CENTERING TEXT.  P10>1
08800	863	RB=0
08900		X=PWDS(L+1)
09000	363	L=L+1
09100		K=PWDS(L)
09200		RB=RB+RN(K+9)
09300	C  ADD SPACE NEEDED
09400		K=PWDS(L+1)
09500		IF(RN(K+1).NE.16)GO TO 463
09600		IF(RN(K).EQ.8)GO TO 363
09700	C GO BACK IF MORE LETTERS TO COME
09800	463	R3=R10-(RB-3.4)*RD*RSTJ2/2.
09900	C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
10000		R10=0
10100		IF(RN(X).EQ.8)RN(X+10)=0
10200		RN(X+3)=R3
10300	C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
10400		GO TO 162
10500	263	K=PWDS(L)
10600		R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
10700	C  AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
10800		R4=RN(K+4)
10900		R5=RN(K+5)
11000		R2=RN(K+2)
11100		J2=R2
11200		L=PWDS(L+1)
11300		DO 361 JJA=3,5
11400	361	RN(L+JJA)=RJQ(JJA-2)
11500		RN(L+2)=R2
11600	162	IF(PLT.NE.0)GO TO 5541
11700	160	RJ3=R3
11800		JJA=JA
11900		IF(R8.NE.0)GO TO 161
12000		IF(JA.EQ.1)R8=999.
12100	C  999=0 FOR STEM EXTENSIONS.
12200	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
12300	161	CALL MSSLUP
12400		IF(JA.NE.6)GO TO 1261
12500		IF(J13.EQ.0)GO TO 171
12600		R2=X22
12700		X22=0
12800		R3=R13
12900		J3=J13
13000		R4=R11
13100	C  RESET HOMING RANGE (DEFAULT=3) WITH P11.
13200		CALL CLRCUR
13300		R13=0
13400	C  TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
13500		JA=19
13600		GO TO 271
13700	171	CALL HOMER
13800	
13900	1261	IF(R13.EQ.0)GO TO 261
14000		RD=R11
14100		IF(CB.NE.0.AND.RD.EQ.0)R11=CB
14200	C *** CB = CENTER-BIG  I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VARY LATER??)
14300		CALL HOMER
14400		CB=0
14500		R11=RD
14600	C  R11 GETS CHANGED IN 'HOMER'
14700	CC	IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
14800	C RSTCEN IS FOR CENTERING WHOLE RESTS.
14900		IF(JA.EQ.10)R3=R3+RSTJ2
15000		IF(JA.NE.9)GO TO 261
15100		IF(J5.GT.3)GO TO 261
15200		CALL NOZERO(R6)
15300		R3=R3+RSTJ2+2.*RSTJ2*R6
15400	C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
15500	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
15600	C  P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
15700	C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHRP,NAT)
15800	C **** FOR '0' EDITS ******
15900	261	CALL LUP2
16000	5541	IF(DP(J2).GE.0)GO TO 61
16100		IF(JA.NE.8)GO TO 57
16200	C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
16300		IF(R5.NE.0)RSTFAC(J2)=R5
16400		GO TO 57
16500	C*** 3/74  NEW DP SYSTEM
16600	C  WHAT ABOUT EDITS?*******
16700	61	POS=STFF(J2)
16800		RX3=R3
16900	C  SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
17000		J3=ROFF(RHORZ(R3))
17100	C  LINE IS DIVIDED INTO 200 POINTS.
17200		CALL CENTX
17300	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
17400		R3=J3
17500		IF(JA.LE.2)GO TO 11
17600	551	GO TO(1,1,68,25,67, 625,116,125,11,69, 68,12),JA
17700		GO TO (116,81,80),JA-15
17800	C  FOR 16,17,18 (WORDS, KSIG, METER)
17900		IF(JA.EQ.99)GO TO 57
18000	C    FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
18100		IF(JA.NE.33.AND.JA.NE.44)GO TO 222
18200		JA=JA/11
18300	C  THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
18400		GO TO 551
18500	
18600	222	I=PWDS(ITEM+1)
18700		GO TO 5505
18800	C  44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
18900	
19000	69	CALL MAKNUM(R5)
19100		GO TO 57
19200	
19300	68	CALL CLEFS
19400		GO TO 57
19500	
19600	67	CALL SLUR
19700		GO TO 57
19800	
19900	116	CALL ALPHA
20000		GO TO 57
20100	
20200	81	CALL KSIG
20300		GO TO 57
20400	
20500	80	CALL METER
20600		GO TO 57
20700	
20800	125	IF(R2.EQ.0)RMOV=R8
20900		CALL STAFF
21000		GO TO 57
21100	CC625	IF(J10.LT.100)GO TO 1625
21200	CC	CALL BEAMX
21300	CC	GO TO 160
21400		
21500	625	CALL BEAMX
21600	CC625	CALL BMSTF
21700		GO TO 57
21800	C   BEAMS, STAFF LINES ****
21900	12	CALL CIRCLE
22000		GO TO 57
22100	
22200	25	CALL ITMSUB
22300	C   BAR LINES, ETC.
22400		GO TO 57
22500	
22600	C  TO GET DISPLAY: 'G'; 'GM'  ADDS TO DPY; 
22700	CC120	IF(X22.NE.0)GO TO 59
22800	C GO BACK IF STILL IN EDIT MODE
22900	120	J2=0
23000		IF(I.EQ.1)GO TO 1220
23100		L=NAME
23200		X=EXT
23300		IF(I2.NE.IM)GO TO 222
23400	C  'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
23500		J2=-1
23600	1220	I1=-1
23700		CALL NAMEXT(INP,NAME,EXT)
23800	C  NOW TYPE 'G NAME' OR 'GM NAME'
23900		IF(NAME.NE.IBLA)GO TO 1221
24000	1225	CALL TYPSTR(' NAME.EXT?  ')
24100	CCC1225	TYPE 21
24200		READ(IDEV,89,END=3502)INP
24300	CQQ	ACCEPT 89,INP
24400	C GO PUT A1'S INTO A5, ETC.
24500		CALL NAMEXT(INP,NAME,EXT)
24600		IF(NAME.EQ.IBLA)GO TO 2220
24700		IF(NAME.NE.'99')GO TO 1221
24800	C TYPE '99' TO BACK OUT OF 'SAVE'.
24900		NAME=L
25000		EXT=X
25100		GO TO 5505
25200	1221	IF(I1.NE.LESS)GO TO 1226
25300		IDEV=5
25400		GO TO 1225
25500	1226	IF(LOOKX(NAME,EXT).EQ.0)GO TO 1225
25600	C  FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
25700	2220	JA=-1
25800	C  -1 IS FOR 8852+3
25900	2200	J=ITEM+1
26000		IF(NAME.NE.IBLA)GO TO 2207
26100		CALL GETEXT('TMP','DMD')
26200		GO TO 2205
26300	2207	CALL GETEXT(NAME,EXT)
26400	2205	IF(J2.EQ.0)GO TO 2202
26500		NAME=L
26600		EXT=X
26700	2202	CALL EXTIN(RSTFAC,128)
26800		CALL EXTIN(PWDS(J),JJ2)
26900		CALL EXTIN(RN(I),IPOS)
27000		ITEM=ITEM+JJ2-2
27100		IF(J2)GO TO 2203
27200	CC	IF(I2.EQ.IM)GO TO 2203
27300	C J2=-1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.*******
27400		IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
27500		I=IPOS
27600		IF(RSTF.EQ.0)GO TO 85
27700	C  (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER 
27800		CALL EXTIN(ST,4302)
27900		CALL DPYNEW
28000		GO TO 5505
28100	
28200	2203	M=I-1
28300		DO 2204 K=J,J+JJ2-2
28400	2204	PWDS(K)=PWDS(K)+M
28500		GO TO 85
28600		M=IX
28700	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
28800	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
28900	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
29000	C RMOV HAS INCHES FROM P8 OF STAFF 0.
29100	C  R6=1 FOR NO MOVE AT END.  R7=INCHES TO MOVE FOR NEW STAFF 0.
29200	C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
29300	C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE.  THEN
29400	C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
29500	C  MOVES PLOTTER UP IF P5=0.
29600	
29700	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
29800	6120	IF(M.GE.I)GO TO 7120
29900		IF(IGO.EQ.0)GO TO 7121
30000	C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
30100		IF(M.EQ.PWDS(ITEM+1))GO TO 7121
30200		K=ITEM+1
30300		CALL TYPSTR('   FIXING ITEM ')
30400		CALL TYPINT(K)
30500		CALL TYPCRLF
30600	CCCC	TYPE 7122,K
30700		PWDS(K)=M
30800	7121	CALL RUNTHR(M)
30900		IF(EDX.LE.0)GO TO 60
31000		GO TO 5505
31100	CCC7122	FORMAT(' FIXING ITEM ',I3)
31200	
31300	7120	M=1
31400		IF(PLT.EQ.1)EDX=-1
31500		PLT=0
31600		GO TO 5505
31700	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
31800	
31900	CCC56	FORMAT(/1XA5,'  TYPE FOR ITEM #',I3,I,I6/)
32000	1	FORMAT(I,24F)
32100	CCC21	FORMAT(' NAME.EXT?  '$)
32200		END